home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ape-ad1a / cdxvbscr.cls < prev    next >
Text File  |  1999-09-21  |  5KB  |  176 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CDXVBScreen"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' ALMOST working...
  15.  
  16. Private Declare Function ShowCursor Lib "User32" (ByVal bShow As Long) As Long
  17.  
  18. Private Declare Function VarPtrArray Lib "msvbvm50.dll" Alias "VarPtr" (Ptr() As Any) As Long
  19. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
  20.  
  21. Private Type SAFEARRAYBOUND
  22.     cElements As Long
  23.     lLbound As Long
  24. End Type
  25.  
  26. Private Type SAFEARRAY1D
  27.     cDims As Integer
  28.     fFeatures As Integer
  29.     cbElements As Long
  30.     cLocks As Long
  31.     pvData As Long
  32.     Bounds(0 To 0) As SAFEARRAYBOUND
  33. End Type
  34.  
  35. Private Type SAFEARRAY2D
  36.     cDims As Integer
  37.     fFeatures As Integer
  38.     cbElements As Long
  39.     cLocks As Long
  40.     pvData As Long
  41.     Bounds(0 To 1) As SAFEARRAYBOUND
  42. End Type
  43.  
  44. Private video_buffer() As Byte
  45. Private sa As SAFEARRAY2D
  46.  
  47. Public m_lpdd As IDirectDraw2
  48. Private m_ddsd As DDSURFACEDESC
  49. Public m_lpDDSFront As IDirectDrawSurface2
  50. Public m_lpDDSBack As IDirectDrawSurface2
  51.  
  52. Public m_PixelWidth As Integer
  53. Public m_PixelHeight As Integer
  54. Public m_BPP As Integer
  55. Public m_HWND As Long
  56. Public m_HDC As Long
  57. Public m_Font As Long
  58.  
  59. Private ScreenRect As RECT
  60.  
  61. Public Function CreateFullScreen(hWnd As Long, Width As Integer, Height As Integer, BPP As Integer, Optional bVGA As Boolean = False) As Boolean
  62.       Dim result As Long
  63.       Dim dwFlags As Long
  64.       Dim ddsCaps1 As DDSCAPS
  65.       Dim ddsd As DDSURFACEDESC
  66.       
  67.       m_PixelWidth = Width
  68.       m_PixelHeight = Height
  69.       m_HWND = hWnd
  70.       m_BPP = BPP
  71.  
  72.       dwFlags = DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN Or DDSCL_ALLOWREBOOT Or DDSCL_ALLOWMODEX
  73.  
  74.       DirectDrawCreate ByVal 0&, m_lpdd, Nothing
  75.       
  76.       m_lpdd.SetCooperativeLevel hWnd, dwFlags
  77.       
  78.       If bVGA = True Then
  79.             m_lpdd.SetDisplayMode Width, Height, BPP, 0, DDSDM_STANDARDVGAMODE
  80.       Else
  81.             m_lpdd.SetDisplayMode Width, Height, BPP, 0, 0
  82.       End If
  83.  
  84.       ddsd.dwSize = Len(ddsd)
  85.       ddsd.dwFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
  86.       ddsd.DDSCAPS.dwCaps = DDSCAPS_PRIMARYSURFACE Or DDSCAPS_FLIP Or DDSCAPS_COMPLEX
  87.       ddsd.dwBackBufferCount = 1
  88.  
  89.       m_lpdd.CreateSurface ddsd, m_lpDDSFront, Nothing
  90.       
  91.       ddsCaps1.dwCaps = DDSCAPS_BACKBUFFER
  92.       
  93.       m_lpDDSFront.GetAttachedSurface ddsCaps1, m_lpDDSBack
  94.       
  95.       With ScreenRect
  96.             .top = 0
  97.             .left = 0
  98.             .bottom = Height
  99.             .right = Width
  100.       End With
  101. End Function
  102.  
  103. Public Function Flip() As Long
  104.       m_lpDDSFront.Flip Nothing, DDFLIP_WAIT
  105. End Function
  106.  
  107. Public Sub CloseCDXVBScreen()
  108.       m_lpdd.FlipToGDISurface
  109.       m_lpdd.SetCooperativeLevel 0, DDSCL_NORMAL
  110.       m_lpdd.RestoreDisplayMode
  111.  
  112.       Set m_lpDDSBack = Nothing
  113.       Set m_lpDDSFront = Nothing
  114.       Set m_lpdd = Nothing
  115. End Sub
  116.  
  117. Public Sub ClearBack()
  118.       Dim ClearFX As DDBLTFX
  119.  
  120.       With ClearFX
  121.             .dwSize = Len(ClearFX)
  122.             .dwFillColor = 0
  123.       End With
  124.  
  125.       m_lpDDSBack.Blt ScreenRect, Nothing, ScreenRect, DDBLT_COLORFILL Or DDBLT_WAIT, ClearFX
  126. End Sub
  127.  
  128. Public Sub HideMouse()
  129.       ShowCursor False
  130. End Sub
  131.  
  132. Public Sub ShowMouse()
  133.       ShowCursor True
  134. End Sub
  135.  
  136. Public Sub SurfGetBackDC()
  137.       m_lpDDSBack.GetDC m_HDC
  138. End Sub
  139.  
  140. Public Sub SurfReleaseBackDC()
  141.       m_lpDDSBack.ReleaseDC m_HDC
  142. End Sub
  143.  
  144. Private Sub Class_Terminate()
  145.       Call CloseCDXVBScreen
  146. End Sub
  147.  
  148. Public Sub LockMe()
  149.       CopyMemory m_ddsd, ByVal 0&, Len(m_ddsd)
  150.       m_ddsd.dwSize = Len(m_ddsd)
  151.  
  152.       m_lpDDSBack.Lock ByVal 0&, m_ddsd, DDLOCK_WAIT Or DDLOCK_SURFACEMEMORYPTR, 0
  153.  
  154.       With sa
  155.             .cbElements = 1
  156.             .cDims = 2
  157.             .Bounds(0).lLbound = 0
  158.             .Bounds(0).cElements = m_ddsd.dwHeight
  159.             .Bounds(1).lLbound = 0
  160.             .Bounds(1).cElements = m_ddsd.dwWidth
  161.             .pvData = m_ddsd.lpSurface
  162.       End With
  163.       CopyMemory ByVal VarPtrArray(video_buffer), VarPtr(sa), 4
  164. End Sub
  165.  
  166. Public Sub Pixel(X As Integer, Y As Integer, Color As Integer)
  167.       video_buffer(X, Y) = Color
  168. End Sub
  169.  
  170. Public Sub UnLockMe()
  171.       m_lpDDSBack.Unlock m_ddsd.lpSurface
  172.  
  173.       CopyMemory ByVal VarPtrArray(video_buffer), ByVal 0&, 4
  174. End Sub
  175.  
  176.